(defpackage :demo
  (:use :cl)
  (:export :demo
           :states
           :make-state
           :state-class
           :state-current
           :state-last
           :state-keypad
           :state-message
           :back
           :forward
           ))

(in-package :demo)

(defstruct (state (:print-function print-state))
  current faded last keypad popup-keypad popup class message overlay-nodes overlay-next-node)

(defun print-state (state stream depth)
  (declare (ignore depth))
  (let ((d:*verbose-node-printing* t))
    (format stream "#S(~s ~@{~s~^ ~})"
            'state
            :current (u:sharp-dot (state-current state))
            :last (u:sharp-dot (state-last state))
            :keypad (state-keypad state)
            :popup-keypad (state-popup-keypad state)
            :popup (u:sharp-dot (state-popup state))
            :class (state-class state)
            :message (state-message state))))

(defclass demo-keypad (kp:tiny-keypad)
  ())

(defmethod gwee:post-initialize-component progn ((obj demo-keypad))
  (dolist (slot '(kp::b1 kp::b2 kp::b3 kp::b4 kp::b5 kp::b6 kp::b7 kp::b8 kp::b9 kp::b0 kp::b+ kp::b- kp::b* kp::b/ kp::bfraction kp::backspace))
    (gwee:remove-hook (gwee:enter-hook (slot-value obj slot)) 'kp::enter-hook)
    (gwee:remove-hook (gwee:leave-hook (slot-value obj slot)) 'kp::leave-hook)))

(defclass rep-view (gwee:view gwee:background-mixin)
  ()
  (:default-initargs
   :background (gwee:gray 255)
   :border-color (gwee:gray 100)))

(defclass my-tree (new-tree:new-tree)
  ((faded :initform nil :accessor faded)))

(defmethod gwee:draw-view :after ((view my-tree))
  (when (faded view)
    (sdl:draw-box-* (gwee:view-to-top-x view 0)
                    (gwee:view-to-top-y view 0)
                    (gwee:view-width view)
                    (gwee:view-height view)
                    :color (gwee:gray 255)
                    :alpha 180)))

(gwee:define-component demo (exp:state)
    ((states :initarg :states :accessor states)
     ;;(instruction-condition :initarg :instruction-condition :accessor instruction-condition)
     (idx :initarg :idx :initform 0 :accessor idx))
  (:views
   (demo-text gwee:text-area :height 50 :left-padding 20 :right-padding 20 :bottom-padding 10 :border-top nil :top-padding 10 :border-color (gwee:gray 150) :y :top :x :center :data "DEMO" :font (gwee:open-font "sans.ttf" 32))
   (divider gwee:divider :margin-bottom 0 :direction :vertical :foreground (gwee:gray 150))
   (divider2 gwee:divider :margin-top 0 :direction :vertical :foreground (gwee:gray 150))
   (diagram my-tree :accessor diagram)
   (last-state new-tree:new-tree :accessor last-state)
   (popup rep-view :x 0 :y 0 :width 0 :height 0 :accessor popup
                      :border-color (gwee:gray 150)
                      :border-left nil
                      :border-right nil)
   (forward gwee:button :data (string (code-char 8594)) :vertical-offset -4 :accessor forward :width 120 :height 60 :font (gwee:open-font "sans.ttf" 64))
   (back gwee:button :data (string (code-char 8592)) :vertical-offset -4 :accessor back :width 120 :height 60 :font (gwee:open-font "sans.ttf" 64))
   (message gwee:text-area
            :width :maximum :height 60 :accessor message
            :font (gwee:open-font "sans.ttf" 18)))
  (:layouts
   (default gwee:column-layout
       (top bottom))
   (top gwee:view
        (diagrams demo-text popup))
   (diagrams gwee:row-layout
       (last-state divider right))
   (right gwee:column-layout
          (diagram-area))
   (empty gwee:view)
   (bottom gwee:row-layout
           (empty divider2 dashboard)
           :height :minimum)
   (nav gwee:row-layout
        (back forward)
        :padding 10
        :height :minimum
        :width :minimum)
   (dashboard gwee:column-layout
              (message nav)
              :margin-top 5
              :margin-bottom 25
              :height :minimum)
   (diagram-area gwee:view
                 (diagram))))

(defmethod exp:state-dump append (exp (state demo))
  `(;; :states ,(when (slot-boundp state 'states)
    ;;                (states state))
    ;;:instruction-condition ,(instruction-condition state)
    ;; :idx ,(idx state)
    ))

(defmethod exp:state-list-actions append (exp (state demo))
  (exp::default-list-actions state))

(defun convert (tree)
  (append (dgraph:convert tree)
          (dgraph:attributes tree)))

(defmethod exp:state-list-objects append (exp (obj demo))
  (labels ((d-top-x (x) (gwee:view-to-top-x (diagram obj) x))
           (d-top-y (y) (gwee:view-to-top-y (diagram obj) y))
           (l-top-x (x) (gwee:view-to-top-x (last-state obj) x))
           (l-top-y (y) (gwee:view-to-top-y (last-state obj) y)))
    (let ((state (elt (states obj) (idx obj))))
      `(:diagram ,(append (convert (state-current state))
                          (when (state-overlay-nodes state)
                            (list (list* :o (mapcar (lambda (id) (intern (format nil "B~a" id)))
                                                    (state-overlay-nodes state))))))
        :diagram-layout ,(loop for b in (d:collect-on-tree (lambda (n) (typep n 'd:box))
                                                           (d:root (diagram obj)))
                               collect (list (d:id b) :x  (d-top-x (geom:x b)) :y (d-top-y (geom:y b))
                                                      :width (geom:width b) :height (geom:height b)
                                                      :cx (d-top-x (geom:centerx b)) :cy (d-top-y (geom:centery b))))
        :last-diagram ,(when (state-last state)
                         (convert (state-last state)))
        :last-diagram-layout ,(when (state-last state)
                                (loop for b in (d:collect-on-tree (lambda (n) (typep n 'd:box))
                                                                  (d:root (last-state obj)))
                                      collect (list (d:id b) :x (l-top-x (geom:x b)) :y (l-top-y (geom:y b))
                                                             :width (geom:width b) :height (geom:height b)
                                                             :cx (l-top-x (geom:centerx b)) :cy (l-top-y (geom:centery b)))))
        :diagram-keypad ,(state-keypad state)
        :diagram-keypad-position ,(when (state-keypad state)
                                    (d:input-location (d:find-node-by-id (state-current state) (state-keypad state))))
        :popup ,(when (state-popup state)
                  (convert (state-popup state)))
        :text ,(gwee:view-data (slot-value obj 'message))
        :buttons ,(list :back
                        (if (string= (gwee:view-data (slot-value obj 'forward))
                                     "Done")
                            :done
                            :forward))))))

(defun make-popup (demo rep keypad class)
  (setf (gwee:view-subviews (popup demo)) nil
        (gwee:view-width (popup demo)) 0
        (gwee:view-height (popup demo)) 0)
  (gwee:delete-views-if (lambda (v) (typep v 'demo-keypad))
                        (gwee:view-parent (popup demo)))
  (when rep
    (let ((view (apply 'make-instance class :parent (popup demo)
                       :x :left :y :center
                       :width 1 :height 1
                       :background nil
                       :arg-margin 2
                       :arg-padding 5
                       (when (eq class 'lv:linear-view)
                         (list :compressed nil)))))
      (setf (d:root view) rep)
      (d:space-tree view)
      (rm::update-rep-size (popup demo) view (diagram demo))
      ;; (let ((dim (d:tree-rectangle (d:root view))))
      ;;   (setf (gwee:view-width view) (geom:width dim)
      ;;         (gwee:view-height view) (geom:height dim)
      ;;         (gwee:view-width (popup demo)) (+ (gwee:view-width view) 30)
      ;;         (gwee:view-height (popup demo)) (+ (gwee:view-height view) 30)))
      ;; (d:update-diagram-view view)
      (when keypad
        (let ((node (d:find-node-by-id rep keypad))
              (input (make-instance 'demo-keypad :parent (gwee:view-parent (popup demo)) :x 0 :y 0)))
          (gwee:sync-views (gwee:view-parent (popup demo)))
          (setf (gwee:view-x input)
                (- (+ (gwee:view-x (popup demo))
                      (gwee:view-x view)
                      (geom:x node))
                   (u:half (- (gwee:view-width input) (geom:width node))))
                (gwee:view-y input)
                (ecase (d:input-location node)
                  (:above
                   (- (+ (gwee:view-y (popup demo))
                         (gwee:view-y view)
                         (geom:y node))
                      (gwee:view-height input)
                      (- (gwee:margin-bottom (slot-value input 'kp::default)))))
                  (:below
                   (- (+ (gwee:view-y (popup demo))
                         (gwee:view-y view)
                         (geom:bottom node))
                      (gwee:margin-bottom (slot-value input 'kp::default)))))))))))


(defun update-state (demo)
  (let* ((state (elt (states demo) (idx demo)))
         (current (tree:copy-node (state-current state) t))
         (node (when (state-keypad state)
                 (or (d:find-node-by-id current
                                        (state-keypad state))
                     (error "Unable to find node ID: ~a" (state-keypad state))))))
    (setf (d:root (diagram demo)) current
          (d:root (last-state demo)) (state-last state)
          (gwee:view-data (message demo)) (state-message state)
          (gwee:view-subviews (diagram demo)) nil
          (faded (diagram demo)) (state-faded state))
    (d:update-diagram-view (diagram demo))
    (d:update-diagram-view (last-state demo))
    (setf (gwee:view-subviews (last-state demo)) nil)
    (setf (gwee:view-subviews (diagram demo)) nil)
    (when (state-overlay-nodes state)
      (beads:add-bead-overlay (diagram demo) (mapcar (lambda (id)
                                                       (d:find-id-or-die (d:root (diagram demo)) id))
                                                     (state-overlay-nodes state))
                              (state-overlay-next-node state)))
    (make-popup demo (state-popup state) (state-popup-keypad state) (state-class state))
    (when node
      (let ((input (make-instance 'demo-keypad :parent (diagram demo) :x 0 :y 0)))
        (gwee:sync-views (diagram demo))
        (setf (gwee:view-x input)
              (- (geom:x node)
                 (u:half (- (gwee:view-width input) (geom:width node))))
              (gwee:view-y input)
              (ecase (d:input-location node)
                (:above
                 (- (geom:y node)
                    (gwee:view-height input)
                    (- (gwee:margin-bottom (slot-value input 'kp::default)))))
                (:below
                 (- (geom:bottom node) (gwee:margin-top (slot-value input 'kp::default))))))))))

(defmethod exp:state-init (exp (state demo))
  (exp:lg 'start :tree (u:sharp-dot (state-current (first (states state)))))
  (exp:wire-button (slot-value state 'forward) :forward)
  (exp:wire-button (slot-value state 'back) :back)
  (dolist (i (states state))
    (setf (state-current i) (tree:recreate-parent-slots (d:merge-by-id (state-current i))))
    (when (state-last i)
      (setf (state-last i) (tree:recreate-parent-slots (d:merge-by-id (state-last i)))))
    (when (and (state-popup i)
               (u:neq (state-class i) 'lv:linear-view))
      (setf (state-popup i) (tree:recreate-parent-slots (d:merge-by-id (state-popup i))))))
  (gwee:sync-views)
  (update-state state))

(exp:define-action forward ((state demo)
                            (exp:click :source :forward))
  (exp:lg 'forward)
  (incf (idx state))
  (cond
    ((>= (idx state) (length (states state)))
     ;; returning to this state, idx would be out of range
     (decf (idx state))
     (exp:state-onward exp:*experiment* state))
    ((>= (idx state) (1- (length (states state))))
     (update-state state)
     (setf (gwee:view-data (forward state)) "Done"
           (gwee:vertical-offset (forward state)) 0
           (gwee:view-font (forward state)) (gwee:open-font "sans.ttf" 32)))
    (t
     (update-state state))))

(exp:define-action back ((state demo)
                         (exp:click :source :back))
  (exp:lg 'back)
  (decf (idx state))
  (cond
    ((< (idx state) 0)
     (setf (idx state) 0))
    ((= (idx state) (- (length (states state)) 2))
     (update-state state)
     (setf (gwee:view-data (forward state)) (string (code-char 8594))
           (gwee:vertical-offset (forward state)) -4
           (gwee:view-font (forward state)) (gwee:open-font "sans.ttf" 64)))
    (t
     (update-state state))))

(defun test ()
  (exp:run-experiment
   `((:gogo (exp:instructions :text "Yeah")
            (demo :states ,(list (make-state :last [m [a 3] [a '+] [a 9]]
                                             :current [m [a 30] [a '+] [i 3 :id 10]]
                                             :keypad 10)
                                 (make-state :last [m [a 30] [a '+] [i 3 :id 10]]
                                             :current [m [i 30 :input-location :above :id 10] [a '+] [i 3]]
                                             :keypad 10)
                                 (make-state :current [m [a 3] [a '+] [a 9]])))
            (exp:end)))
   :resizable t
   :width 1200
   :height 800
   :version (boxes.util:version)))
